home *** CD-ROM | disk | FTP | other *** search
/ DS-CD ROM 2 1993 August / DS CD-ROM 2.Ausgabe (August 1993).iso / programm / ds0045 / spritsrc.exe / SPRITEED.BAK < prev    next >
Text File  |  1991-08-30  |  16KB  |  528 lines
  1. program sprite_editor;                    {Version 1.2 vom 29.01.1991}
  2. uses drv_link,crt,graph,mouselib,butlib;
  3.  
  4. const max_x_gr = 32;
  5.       max_y_gr = 32;
  6.  
  7. var sprite_exists : boolean;
  8.     sprite_saved  : boolean;
  9.     programm_ende : boolean;
  10.     ident         : array [0..3] of byte;
  11.     daten         : array [0..max_x_gr-1,0..max_y_gr-1] of byte;
  12.     spr_x_gr      : byte;
  13.     spr_y_gr      : byte;
  14.     sprite_color  : word;
  15.     sprite_bk     : word;
  16.     myfile        : file;
  17.     dum_char      : char;
  18.  
  19. procedure def_buttons;
  20. var t : integer;
  21. begin
  22. enter_default_graphmode;
  23. sprite_color:=getmaxcolor;
  24. sprite_bk:=0;
  25. deftextbutton(1,1,1,21,'Col 01',false,' ',0);
  26. deftextbutton(1,2,1,23,'Col 02',false,' ',0);
  27. deftextbutton(1,3,9,21,'Col 03',false,' ',0);
  28. deftextbutton(1,4,9,23,'Col 04',false,' ',0);
  29. deftextbutton(1,5,17,21,'Col 05',false,' ',0);
  30. deftextbutton(1,6,17,23,'Col 06',false,' ',0);
  31. deftextbutton(1,7,25,21,'Col 07',false,' ',0);
  32. deftextbutton(1,8,25,23,'Col 08',false,' ',0);
  33. deftextbutton(1,9,33,21,'Col 09',false,' ',0);
  34. deftextbutton(1,10,33,23,'Col 10',false,' ',0);
  35. deftextbutton(1,11,41,21,'Col 11',false,' ',0);
  36. deftextbutton(1,12,41,23,'Col 12',false,' ',0);
  37. deftextbutton(1,13,49,21,'Col 13',false,' ',0);
  38. deftextbutton(1,14,49,23,'Col 14',false,' ',0);
  39. deftextbutton(1,15,57,21,'Col 15',false,' ',0);
  40. deftextbutton(1,16,57,23,'Col 16',false,' ',0);
  41. deftextbutton(1,17,70,21,'  Clear ',true,' ',0);
  42. deftextbutton(1,18,70,23,'  Exit  ',true,' ',0);
  43. for t:=1 to 16 do begin
  44.     button_colors[1,t,0]:=t-1;
  45.     button_colors[1,t,1]:=t-1;
  46.     if t<11 then button_colors[1,t,2]:=15 else button_colors[1,t,2]:=0;
  47.     end;
  48. button_colors[1,1,1]:=15;
  49. button_colors[1,17,2]:=12;
  50. button_colors[1,18,2]:=10;
  51. closegraph;
  52. end;
  53.  
  54. procedure empty_key_buf;
  55. var dummy : char;
  56. begin
  57. while keypressed do dummy:=readkey;
  58. end;
  59.  
  60. function big_menu : word;
  61. var wahl  : char;
  62.     ok    : integer;
  63.     dummy : integer;
  64. begin
  65. clrscr;
  66. writeln('SPRITLIB V1.2 (C) 1991 Uwe Kuhring - Sprites für Turbo Pascal.');
  67. writeln('Dies ist der Sprite-Editor (SPRITEED.EXE).');
  68. writeln('');
  69. writeln('');
  70. writeln('Folgende Funktionen stehen Ihnen zur Auswahl:');
  71. writeln('');
  72. writeln('         <1> = Neues Sprite definieren.');
  73. writeln('         <2> = Aktuelles Sprite editieren.');
  74. writeln('         <3> = Aktuelles Sprite speichern.');
  75. writeln('         <4> = Altes Sprite laden.');
  76. writeln('         <5> = Aktuelles Sprite konvertieren.');
  77. writeln('         <0> = Sprite-Editor verlassen.');
  78. empty_key_buf;
  79. repeat
  80.    repeat until keypressed;
  81.    wahl:=readkey;
  82.    val (wahl,dummy,ok);
  83.    until (ok=0) and (dummy<6) and (dummy>-1);
  84. big_menu:=dummy;
  85. end;
  86.  
  87. function sicherheit : boolean;
  88. var wahl  : char;
  89. begin
  90. sicherheit:=true;
  91. if sprite_exists then if not sprite_saved then begin
  92.    clrscr;
  93.    writeln ('Dieses Kommando führt zum Verlust des aktuellen Sprites!');
  94.    writeln ('Soll ich das Kommando <a>usführen oder <z>urücknehmen?');
  95.    empty_key_buf;
  96.    repeat
  97.       repeat until keypressed;
  98.       wahl:=readkey;
  99.       until (upcase(wahl)='Z') or (upcase(wahl)='A');
  100.    if upcase(wahl)='Z' then sicherheit:=false;
  101.    end;
  102. end;
  103.  
  104. procedure neue_definitionen;
  105. var xs : string;
  106.     ys : string;
  107.     ok : integer;
  108.     t  : integer;
  109.     u  : integer;
  110. begin
  111. clrscr;
  112. writeln('Bitte definieren Sie nun die Größe des neuen Sprites.');
  113. writeln('Der zulässige Bereich in X ist:  8..',max_x_gr);
  114. writeln('Der zulässige Bereich in Y ist:  8..',max_y_gr);
  115. empty_key_buf;
  116. repeat
  117.    writeln('');
  118.    write('Größe des Sprites in X: ');
  119.    readln(xs);
  120.    val(xs,spr_x_gr,ok);
  121.    if (ok<>0) or (spr_x_gr<8) or (spr_x_gr>max_x_gr) then ok:=0 else ok:=1;
  122.    if ok=0 then writeln ('Die Eingabe war unkorrekt, bitte wiederholen!');
  123.    until ok=1;
  124. empty_key_buf;
  125. repeat
  126.    writeln('');
  127.    write('Größe des Sprites in Y: ');
  128.    readln(ys);
  129.    val(ys,spr_y_gr,ok);
  130.    if (ok<>0) or (spr_y_gr<8) or (spr_y_gr>max_y_gr) then ok:=0 else ok:=1;
  131.    if ok=0 then writeln ('Die Eingabe war unkorrekt, bitte wiederholen!');
  132.    until ok=1;
  133. for t:=0 to max_x_gr-1 do for u:=0 to max_y_gr-1 do daten[t,u]:=0;
  134. sprite_exists:=true;
  135. sprite_saved:=false;
  136. end;
  137.  
  138. procedure warnton;
  139. begin
  140. sound(50);
  141. delay(100);
  142. sound(30);
  143. delay(200);
  144. nosound;
  145. end;
  146.  
  147. procedure edit_sprite;
  148. var gx,gy   : word;
  149.     rax,ray : word;
  150.     t,u     : integer;
  151.     mb,but  : integer;
  152.     c_merk  : integer;
  153.     x,y,b   : integer;
  154.     lxpos   : word;
  155.  
  156. procedure fill_square(x,y,c : integer);
  157. begin
  158. if c<0 then c:=-c else if c=1 then c:=sprite_color else c:=sprite_bk;
  159. c_merk:=getcolor;
  160. setcolor(c);
  161. setfillstyle(1,c);
  162. mouseoff;
  163. rectangle(x*rax+1,y*ray+1,(x+1)*rax-1,(y+1)*ray-1);
  164. floodfill(x*rax+2,y*ray+2,c);
  165. putpixel(lxpos+x,100+y,c);
  166. daten[x,y]:=c;
  167. mouseon;
  168. setcolor(c_merk);
  169. end;
  170.  
  171. begin
  172. enter_default_graphmode;
  173. cleardevice;
  174. lxpos:=getmaxx-max_x_gr;
  175. gx:=trunc((getmaxx+1)*0.75) ; gy:=trunc((getmaxy+1)*0.75);
  176. rax:=trunc(gx/spr_x_gr) ; ray:=trunc(gy/spr_y_gr);
  177. for t:=0 to spr_x_gr do line(t*rax,0,t*rax,spr_y_gr*ray);
  178. for t:=0 to spr_y_gr do line(0,t*ray,spr_x_gr*rax,t*ray);
  179. defbuttonplane(1) ; mouseon;
  180. for t:=0 to spr_x_gr-1 do for u:=0 to spr_y_gr-1 do begin
  181.   if daten[t,u]>0 then fill_square(t,u,-daten[t,u]);
  182.   end;
  183. repeat
  184.    pressedbutton(but,mb,dum_char);
  185.    if mb>0 then begin
  186.       if but=18 then if mb=1 then begin
  187.          revertbutton(18);
  188.          repeat mousestat(x,y,b) until b=0;
  189.          revertbutton(18);
  190.          mouseoff;
  191.          closegraph;
  192.          exit;
  193.          end;
  194.       if but=17 then if mb=1 then begin
  195.          revertbutton(17);
  196.          for t:=0 to spr_x_gr-1 do for u:=0 to spr_y_gr-1 do
  197.          if daten[t,u]<>sprite_bk then fill_square(t,u,2);
  198.          repeat mousestat(x,y,b) until b=0;
  199.          revertbutton(17);
  200.          end;
  201.       if (but>0) and (but<17) and (mb in [1,2]) then begin
  202.          revertbutton(but);
  203.          if mb=1 then sprite_color:=but-1 else sprite_bk:=but-1;
  204.          repeat mousestat(x,y,b) until b=0;
  205.          revertbutton(but);
  206.          end;
  207.       if but=0 then if mb in [1,2] then begin
  208.          mousestat(x,y,b);
  209.          x:=x div rax ; y:=y div ray;
  210.          if (x<spr_x_gr) and (y<spr_y_gr) then begin
  211.             fill_square(x,y,mb);
  212.             sprite_saved:=false;
  213.             end
  214.          else begin
  215.             if mb=1 then begin
  216.                revertbutton(sprite_color+1);
  217.                delay(10);
  218.                revertbutton(sprite_color+1);
  219.                end
  220.             else begin
  221.                revertbutton(sprite_bk+1);
  222.                delay(10);
  223.                revertbutton(sprite_bk+1);
  224.                end;
  225.             end;
  226.          end;
  227.       end;
  228.    until false;
  229. end;
  230.  
  231. procedure sprite_speichern;
  232. var name : string;
  233. begin
  234. clrscr;
  235. writeln('Bitte geben Sie jetzt den Pfad- und Dateinamen des Sprites ein:');
  236. write('Speichern unter: ');
  237. empty_key_buf;
  238. readln(name);
  239. writeln('');
  240. if name='' then begin
  241.    writeln('Speichervorgang wurde abgebrochen.');
  242.    delay(1000);
  243.    exit;
  244.    end;
  245. {$I-}
  246. assign(myfile,name);
  247. ident[0]:=ord('T') ; ident[1]:=ord('S');
  248. ident[2]:=spr_x_gr ; ident[3]:=spr_y_gr;
  249. rewrite(myfile,4);
  250. blockwrite(myfile,ident[0],1);
  251. blockwrite(myfile,daten[0,0],256);
  252. close(myfile);
  253. {$I+}
  254. if ioresult=0 then begin
  255.    writeln ('Speicherung war erfolgreich.');
  256.    sprite_saved:=true;
  257.    end
  258. else begin
  259.    writeln('Speicherung des Sprites ist nicht gelungen!');
  260.    warnton;
  261.    end;
  262. delay(2000);
  263. end;
  264.  
  265. procedure sprite_laden;
  266. var name : string;
  267. begin
  268. clrscr;
  269. writeln('Bitte geben Sie jetzt den Pfad- und Dateinamen des Sprites ein:');
  270. write('Lade Sprite: ');
  271. empty_key_buf;
  272. readln(name);
  273. writeln('');
  274. if name='' then begin
  275.    writeln('Ladevorgang wurde abgebrochen.');
  276.    delay(1000);
  277.    exit;
  278.    end;
  279. {$I-}
  280. assign(myfile,name);
  281. reset(myfile,4);
  282. blockread(myfile,ident[0],1);
  283. blockread(myfile,daten[0,0],256);
  284. close(myfile);
  285. {$I+}
  286. if ioresult=0 then writeln ('Datei wurde korrekt geladen.')
  287. else begin
  288.    writeln('Das Sprite konnte nicht geladen werden!');
  289.    warnton;
  290.    delay(2000);
  291.    sprite_exists:=false ; sprite_saved:=false;
  292.    exit;
  293.    end;
  294. if (chr(ident[0])='T') and (chr(ident[1])='S') then begin
  295.    writeln('Die Datei ist ein Sprite von TP_SPRIT.');
  296.    spr_x_gr:=ident[2] ; spr_y_gr:=ident[3];
  297.    sprite_exists:=true ; sprite_saved:=true;
  298.    end
  299. else begin
  300.    writeln('Die Datei ist KEIN Sprite von TP-SPRIT!');
  301.    warnton;
  302.    sprite_exists:=false ; sprite_saved:=false;
  303.    end;
  304. delay(3000);
  305. end;
  306.  
  307. procedure verschieben(n : integer ; frage : boolean);
  308. var schub : string;
  309.     pixs  : integer;
  310.     ok    : word;
  311.     t,u,v : integer;
  312. begin
  313. if frage then begin
  314.    clrscr;
  315.    write ('Um wieviele Pixel verschieben ?  ');
  316.    readln (schub);
  317.    writeln('');
  318.    val(schub,pixs,ok);
  319.    if (ok<>0) or (pixs<1) or ((pixs>max_x_gr)  and (pixs>max_y_gr)) then begin
  320.       writeln ('Die Angabe war nicht korrekt - keine Verschiebung vorgenommen.');
  321.       warnton;
  322.       delay(2500);
  323.       exit;
  324.       end;
  325.    end
  326. else begin
  327.    pixs:=spr_x_gr;
  328.    if spr_y_gr>pixs then pixs:=spr_y_gr;
  329.    end;
  330. ok:=1 ; t:=0;
  331. if n=3  then repeat
  332.    for u:=0 to spr_y_gr-1 do if daten[0,u]<>sprite_bk then ok:=0;
  333.    if ok=1 then begin
  334.       for u:=1 to spr_x_gr-1 do for v:=0 to spr_y_gr-1 do
  335.       daten[u-1,v]:=daten[u,v];
  336.       for u:=0 to spr_y_gr-1 do daten[spr_x_gr-1,u]:=sprite_bk;
  337.       end;
  338.    if ok=1 then inc(t);
  339.    until (ok=0) or (t=pixs);
  340. if n=2  then repeat
  341.    for u:=0 to spr_y_gr-1 do if daten[spr_x_gr-1,u]<>sprite_bk then ok:=0;
  342.    if ok=1 then begin
  343.       for u:=spr_x_gr-2 downto 0 do for v:=0 to spr_y_gr-1 do
  344.       daten[u+1,v]:=daten[u,v];
  345.       for u:=0 to spr_y_gr-1 do daten[0,u]:=sprite_bk;
  346.       end;
  347.    if ok=1 then inc(t);
  348.    until (ok=0) or (t=pixs);
  349. if n=1  then repeat
  350.    for u:=0 to spr_x_gr-1 do if daten[u,spr_y_gr-1]<>sprite_bk then ok:=0;
  351.    if ok=1 then begin
  352.       for u:=spr_y_gr-2 downto 0 do for v:=0 to spr_x_gr-1 do
  353.       daten[v,u+1]:=daten[v,u];
  354.       for u:=0 to spr_x_gr-1 do daten[u,0]:=sprite_bk;
  355.       end;
  356.    if ok=1 then inc(t);
  357.    until (ok=0) or (t=pixs);
  358. if n=0  then repeat
  359.    for u:=0 to spr_x_gr-1 do if daten[u,0]<>sprite_bk then ok:=0;
  360.    if ok=1 then begin
  361.       for u:=1 to spr_y_gr-1 do for v:=0 to spr_x_gr-1 do
  362.       daten[v,u-1]:=daten[v,u];
  363.       for u:=0 to spr_x_gr-1 do daten[u,spr_y_gr-1]:=sprite_bk;
  364.       end;
  365.    if ok=1 then inc(t);
  366.    until (ok=0) or (t=pixs);
  367. if frage then begin
  368.    writeln ('Das Sprite konnte um ',t,' Pixel verschoben werden.');
  369.    delay(2500);
  370.    end;
  371. end;
  372.  
  373. procedure konvert_sprite;
  374. var wahl   : char;
  375.     ok     : integer;
  376.     dummy  : integer;
  377.     k_ende : boolean;
  378.     t,u    : integer;
  379.     xs,ys  : string;
  380.     x,y    : word;
  381. begin
  382. k_ende:=false;
  383. repeat
  384.    clrscr;
  385.    writeln('Folgende Kovertierungen stehen Ihnen zur Auswahl:');
  386.    writeln('');
  387.    writeln('         <1> = Sprite auf Minimalgröße bringen.');
  388.    writeln('         <2> = Sprite auf Maximalgröße bringen.');
  389.    writeln('         <3> = Sprite auf vorgegebene Größe bringen.');
  390.    writeln('         <4> = Sprite nach oben verschieben.');
  391.    writeln('         <5> = Sprite nach unten verschieben.');
  392.    writeln('         <6> = Sprite nach rechts verschieben.');
  393.    writeln('         <7> = Sprite nach links verschieben.');
  394.    writeln('         <0> = Sprite-Konverter verlassen.');
  395.    empty_key_buf;
  396.    repeat
  397.       repeat until keypressed;
  398.       wahl:=readkey;
  399.       val (wahl,dummy,ok);
  400.       until (ok=0) and (dummy<8) and (dummy>-1);
  401.    case dummy of
  402.       0 : k_ende:=true;
  403.       1 : begin
  404.              clrscr;
  405.              writeln ('Sprite wird auf Minimalgröße gebracht.');
  406.              verschieben(0,false) ; verschieben(3,false);
  407.              u:=spr_x_gr-1 ; ok:=1;
  408.              while (u>7) and (ok=1) do begin
  409.                 for t:=0 to spr_y_gr-1 do if daten[u,t]<>sprite_bk then
  410.                 ok:=0;
  411.                 if ok=1 then begin
  412.                    for t:=0 to spr_y_gr-1 do daten[u,t]:=0;
  413.                    dec(spr_x_gr);
  414.                    end;
  415.                 dec(u);
  416.                 end;
  417.              u:=spr_y_gr-1 ; ok:=1;
  418.              while (u>7) and (ok=1) do begin
  419.                 for t:=0 to spr_x_gr-1 do if daten[t,u]<>sprite_bk then
  420.                 ok:=0;
  421.                 if ok=1 then begin
  422.                    for t:=0 to spr_x_gr-1 do daten[t,u]:=0;
  423.                    dec(spr_y_gr);
  424.                    end;
  425.                 dec(u);
  426.                 end;
  427.              delay(2000);
  428.              end;
  429.       2 : begin
  430.              clrscr;
  431.              writeln ('Sprite wird auf Maximalgröße gebracht.');
  432.              for t:=0 to max_x_gr-1 do begin
  433.                  if t<spr_x_gr then
  434.                     for u:=spr_y_gr to max_y_gr-1 do daten[t,u]:=sprite_bk
  435.                  else
  436.                     for u:=0 to max_y_gr-1 do daten[t,u]:=sprite_bk;
  437.                  end;
  438.              spr_x_gr:=max_x_gr ; spr_y_gr:=max_y_gr;
  439.              delay(2000);
  440.              end;
  441.       3 : begin
  442.              clrscr;
  443.              writeln('Bitte definieren Sie nun die neue Größe des Sprites.');
  444.              writeln('Der zulässige Bereich in X ist:  8..',max_x_gr);
  445.              writeln('Der zulässige Bereich in Y ist:  8..',max_y_gr);
  446.              writeln('Verkleinerung ist nur möglich, soweit es das Sprite erlaubt.');
  447.              empty_key_buf;
  448.              writeln('');
  449.              write('Größe des Sprites in X: ');
  450.              readln(xs);
  451.              val(xs,x,ok);
  452.              if (ok<>0) or (x<8) or (x>max_x_gr) then ok:=0 else ok:=1;
  453.              if ok=0 then begin
  454.                 writeln ('Die Eingabe war unkorrekt, Funktion abgebrochen.');
  455.                 warnton;
  456.                 delay(2000);
  457.                 end
  458.              else begin
  459.                 write('Größe des Sprites in Y: ');
  460.                 readln(ys);
  461.                 val(ys,y,ok);
  462.                 if (ok<>0) or (y<8) or (y>max_y_gr) then ok:=0 else ok:=1;
  463.                 if ok=0 then begin
  464.                    writeln ('Die Eingabe war unkorrekt, Funktion abgebrochen.');
  465.                    warnton;
  466.                    delay(2000);
  467.                    end;
  468.                 end;
  469.              if ok=1 then begin
  470.                 writeln ('Sprite wird angepaßt.');
  471.                 verschieben(0,false) ; verschieben(3,false);
  472.                 u:=spr_x_gr-1 ; ok:=1;
  473.                 while (u>x-1) and (ok=1) do begin
  474.                    for t:=0 to spr_y_gr-1 do if daten[u,t]<>sprite_bk then
  475.                    ok:=0;
  476.                    if ok=1 then begin
  477.                       for t:=0 to spr_y_gr-1 do daten[u,t]:=0;
  478.                       dec(spr_x_gr);
  479.                       end;
  480.                    dec(u);
  481.                    end;
  482.                 u:=spr_y_gr-1 ; ok:=1;
  483.                 while (u>y-1) and (ok=1) do begin
  484.                    for t:=0 to spr_x_gr-1 do if daten[t,u]<>sprite_bk then
  485.                    ok:=0;
  486.                    if ok=1 then begin
  487.                       for t:=0 to spr_x_gr-1 do daten[t,u]:=0;
  488.                       dec(spr_y_gr);
  489.                       end;
  490.                    dec(u);
  491.                    end;
  492.                 for t:=0 to x-1 do begin
  493.                     if t<spr_x_gr then
  494.                        for u:=spr_y_gr to y-1 do daten[t,u]:=sprite_bk
  495.                     else
  496.                     for u:=0 to y-1 do daten[t,u]:=sprite_bk;
  497.                     end;
  498.                 if x>spr_x_gr then spr_x_gr:=x;
  499.                 if y>spr_y_gr then spr_y_gr:=y;
  500.                 delay(2000);
  501.                 end;
  502.              end;
  503.       4 : verschieben(0,true);
  504.       5 : verschieben(1,true);
  505.       6 : verschieben(2,true);
  506.       7 : verschieben(3,true);
  507.       end;
  508.    until k_ende;
  509. end;
  510.  
  511. begin
  512. programm_ende:=false;
  513. sprite_exists:=false;
  514. sprite_saved:=false;
  515. def_buttons;
  516. dum_char:=chr(255);
  517. repeat
  518.    case big_menu of
  519.       0 : if sicherheit then programm_ende:=true;
  520.       1 : if sicherheit then neue_definitionen;
  521.       2 : if sprite_exists then edit_sprite else warnton;
  522.       3 : if sprite_exists then sprite_speichern else warnton;
  523.       4 : if sicherheit then sprite_laden;
  524.       5 : if sprite_exists then konvert_sprite else warnton;
  525.       end;
  526.    until programm_ende;
  527. clrscr;
  528. end.